home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / guile / 1.8 / ice-9 / debugger / commands.scm < prev    next >
Encoding:
Text File  |  2008-12-17  |  5.6 KB  |  155 lines
  1. ;;;; (ice-9 debugger commands) -- debugger commands
  2.  
  3. ;;; Copyright (C) 2002, 2006 Free Software Foundation, Inc.
  4. ;;;
  5. ;; This library is free software; you can redistribute it and/or
  6. ;; modify it under the terms of the GNU Lesser General Public
  7. ;; License as published by the Free Software Foundation; either
  8. ;; version 2.1 of the License, or (at your option) any later version.
  9. ;; 
  10. ;; This library is distributed in the hope that it will be useful,
  11. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13. ;; Lesser General Public License for more details.
  14. ;; 
  15. ;; You should have received a copy of the GNU Lesser General Public
  16. ;; License along with this library; if not, write to the Free Software
  17. ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  18.  
  19. (define-module (ice-9 debugger commands)
  20.   #:use-module (ice-9 debug)
  21.   #:use-module (ice-9 debugger)
  22.   #:use-module (ice-9 debugger state)
  23.   #:use-module (ice-9 debugger utils)
  24.   #:export (backtrace
  25.         evaluate
  26.         info-args
  27.         info-frame
  28.         position
  29.         up
  30.         down
  31.         frame))
  32.  
  33. (define (backtrace state n-frames)
  34.   "Print backtrace of all stack frames, or innermost COUNT frames.
  35. With a negative argument, print outermost -COUNT frames.
  36. If the number of frames isn't explicitly given, the debug option
  37. `depth' determines the maximum number of frames printed."
  38.   (let ((stack (state-stack state)))
  39.     ;; Kludge around lack of call-with-values.
  40.     (let ((values
  41.        (lambda (start end)
  42.          (display-backtrace stack
  43.                 (current-output-port)
  44.                 (if (memq 'backwards (debug-options))
  45.                     start
  46.                     (- end 1))
  47.                 (- end start))
  48.          )))
  49.       (let ((end (stack-length stack)))
  50.     (cond ((not n-frames) ;(>= (abs n-frames) end))
  51.            (values 0 (min end (cadr (memq 'depth (debug-options))))))
  52.           ((>= n-frames 0)
  53.            (values 0 n-frames))
  54.           (else
  55.            (values (+ end n-frames) end)))))))
  56.  
  57. (define (eval-handler key . args)
  58.   (let ((stack (make-stack #t eval-handler)))
  59.     (if (= (length args) 4)
  60.     (apply display-error stack (current-error-port) args)
  61.     ;; We want display-error to be the "final common pathway"
  62.     (catch #t
  63.            (lambda ()
  64.          (apply bad-throw key args))
  65.            (lambda (key . args)
  66.          (apply display-error stack (current-error-port) args)))))
  67.   (throw 'continue))
  68.  
  69. (define (evaluate state expression)
  70.   "Evaluate an expression in the environment of the selected stack frame.
  71. The expression must appear on the same line as the command, however it
  72. may be continued over multiple lines."
  73.   (let ((source (frame-source (stack-ref (state-stack state)
  74.                      (state-index state)))))
  75.     (if (not source)
  76.     (display "No environment for this frame.\n")
  77.     (catch 'continue
  78.            (lambda ()
  79.          (lazy-catch #t
  80.                  (lambda ()
  81.                    (let* ((expr
  82.                        ;; We assume that no one will
  83.                        ;; really want to evaluate a
  84.                        ;; string (since it is
  85.                        ;; self-evaluating); so if we
  86.                        ;; have a string here, read the
  87.                        ;; expression to evaluate from
  88.                        ;; it.
  89.                        (if (string? expression)
  90.                        (with-input-from-string expression
  91.                                    read)
  92.                        expression))
  93.                       (env (memoized-environment source))
  94.                       (value (local-eval expr env)))
  95.                  (write expr)
  96.                  (display " => ")
  97.                  (write value)
  98.                  (newline)))
  99.                  eval-handler))
  100.            (lambda args args)))))
  101.  
  102. (define (info-args state)
  103.   "Display the argument variables of the current stack frame.
  104. Arguments can also be seen in the backtrace, but are presented more
  105. clearly by this command."
  106.   (let ((index (state-index state)))
  107.     (let ((frame (stack-ref (state-stack state) index)))
  108.       (write-frame-index-long frame)
  109.       (write-frame-args-long frame))))
  110.  
  111. (define (info-frame state)
  112.   "Display a verbose description of the selected frame.  The
  113. information that this command provides is equivalent to what can be
  114. deduced from the one line summary for the frame that appears in a
  115. backtrace, but is presented and explained more clearly."
  116.   (write-state-long state))
  117.  
  118. (define (position state)
  119.   "Display the name of the source file that the current expression
  120. comes from, and the line and column number of the expression's opening
  121. parenthesis within that file.  This information is only available when
  122. the 'positions read option is enabled."
  123.   (let* ((frame (stack-ref (state-stack state) (state-index state)))
  124.      (source (frame-source frame)))
  125.     (if (not source)
  126.     (display "No source available for this frame.")
  127.     (let ((position (source-position source)))
  128.       (if (not position)
  129.           (display "No position information available for this frame.")
  130.           (display-position position)))))
  131.   (newline))
  132.  
  133. (define (up state n)
  134.   "Move @var{n} frames up the stack.  For positive @var{n}, this
  135. advances toward the outermost frame, to lower frame numbers, to
  136. frames that have existed longer.  @var{n} defaults to one."
  137.   (set-stack-index! state (+ (state-index state) (or n 1)))
  138.   (write-state-short state))
  139.  
  140. (define (down state n)
  141.   "Move @var{n} frames down the stack.  For positive @var{n}, this
  142. advances toward the innermost frame, to higher frame numbers, to frames
  143. that were created more recently.  @var{n} defaults to one."
  144.   (set-stack-index! state (- (state-index state) (or n 1)))
  145.   (write-state-short state))
  146.  
  147. (define (frame state n)
  148.   "Select and print a stack frame.
  149. With no argument, print the selected stack frame.  (See also \"info frame\").
  150. An argument specifies the frame to select; it must be a stack-frame number."
  151.   (if n (set-stack-index! state (frame-number->index n (state-stack state))))
  152.   (write-state-short state))
  153.  
  154. ;;; (ice-9 debugger commands) ends here.
  155.